home *** CD-ROM | disk | FTP | other *** search
/ Developer Helper 1: Phil & Dave's Excellent CD / Excellent CD HFS.raw / Moof / Goodies / HyperCard Goodies / HyperCard Dev. ToolKit / Serial & MacinTalk XCMDs / GetDocs.p < prev    next >
Text File  |  1987-07-05  |  4KB  |  149 lines
  1. {$R-}
  2.  
  3. (*
  4.     GetDocs -- update document representatives stack
  5.  
  6.     pascal GetDocs.p
  7.     link -m ENTRYPOINT -o {BOOT}docs -rt XCMD=2 -sn Main=GetDocs GetDocs.p.o ∂
  8.       {MPW}Libraries:Interface.o {MPW}PLibraries:PasLib.o
  9.         {boot}hypercard
  10.     
  11. *)
  12.  
  13. {$S GetDocs }     { Segment name must be the same as the command name. }
  14.  
  15. UNIT DummyUnit;
  16.  
  17. INTERFACE
  18.  
  19. USES MemTypes, QuickDraw, OSIntf, ToolIntf, HyperXCmd;
  20.  
  21. PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  22.     
  23. IMPLEMENTATION
  24.  
  25. TYPE Str31 = String[31];
  26.  
  27. PROCEDURE GetDocs(paramPtr: XCmdPtr);                             FORWARD;
  28.  
  29.   PROCEDURE EntryPoint(paramPtr: XCmdPtr);
  30.   BEGIN
  31.     GetDocs(paramPtr);
  32.   END;
  33.  
  34.   PROCEDURE GetDocs(paramPtr: XCmdPtr);
  35.   VAR pathName: Str255;
  36.       fileName:    Str255;
  37.       paramBlock: CInfoPBRec;
  38.       deskTop: INTEGER;
  39.       
  40.     {$I XCmdGlue.inc }
  41.     
  42.     FUNCTION CardExists: BOOLEAN;
  43.     { do we already have a card for this document? }
  44.     VAR result: Handle;
  45.     BEGIN
  46.       SendCardMessage(Concat('find "',fileName,'"'));
  47.       result := EvalExpr('the result');
  48.       CardExists := result^^ = 0;
  49.       DisposHandle(result);
  50.     END;
  51.     
  52.     PROCEDURE PutField(fieldName,fieldVal: Str255);
  53.     VAR h: Handle;
  54.     BEGIN
  55.       h := PasToZero(fieldVal);
  56.       SetFieldByName(FALSE,fieldName,h);
  57.       DisposHandle(h);
  58.     END;
  59.     
  60.     FUNCTION OSTypeToStr(str: OSType): Str31;
  61.     VAR result: Str31;
  62.     BEGIN
  63.       result[0] := CHR(4);
  64.       BlockMove(@str,Pointer(ORD(@result)+1),4);
  65.       OSTypeToStr := result;
  66.     END;
  67.       
  68.     PROCEDURE DoOneFile;
  69.     TYPE PasPtr = ^Str255;
  70.     VAR cmnt: Handle;
  71.     BEGIN
  72.       IF CardExists THEN EXIT(DoOneFile);
  73.       SendCardMessage('go to last card');
  74.       SendCardMessage('doMenu "New Card"');
  75.       PutField('Name',fileName);
  76.       PutField('Where',pathName);
  77.       PutField('Type',OSTypeToStr(paramBlock.ioFlFndrInfo.fdType));
  78.       PutField('Creator',OSTypeToStr(paramBlock.ioFlFndrInfo.fdCreator));
  79.       PutField('Created',LongToStr(paramBlock.ioFlCrDat));
  80.       SendCardMessage('convert field "Created" to long date');
  81.       PutField('Modified',LongToStr(paramBlock.ioFlMdDat));
  82.       SendCardMessage('convert field "Modified" to long date');
  83.       PutField('Size',Concat(LongToStr((paramBlock.ioFlPyLen+paramBlock.ioFLRPyLen+1023) DIV 1024),' K'));
  84.       cmnt := GetResource('FCMT',paramBlock.ioFlXFndrInfo.fdComment);
  85.       IF cmnt <> NIL THEN PutField('Notes',PasPtr(cmnt^)^);
  86.       (***
  87.       ioFlXFndrInfo.fdIconID
  88.       ***)
  89.     END;
  90.       
  91.     PROCEDURE DoOnePath;
  92.     VAR fileIndex: INTEGER;
  93.     result:    INTEGER;
  94.     wdParams: WDPBRec;
  95.     BEGIN
  96.       { set up working directory }
  97.       ZeroBytes(@wdParams,SizeOf(wdParams));
  98.       WITH wdParams DO
  99.     BEGIN
  100.       ioNamePtr := @pathName;
  101.       ioWDProcID := $4552494B;  { 'ERIK' so finder will delete later }
  102.       ioWDDirID := 2;
  103.     END;
  104.       SetResLoad(FALSE);
  105.       SetResLoad(TRUE);
  106.       result := PBOpenWD(@wdParams,FALSE);
  107.       IF result <> 0 THEN EXIT(DoOnePath);
  108.  
  109.       { step through each file in this directory }
  110.       fileIndex := 1;
  111.       REPEAT
  112.     ZeroBytes(@paramBlock,SizeOf(paramBlock));
  113.     WITH paramBlock DO
  114.       BEGIN
  115.         fileName := '';
  116.         ioNamePtr := @fileName;
  117.         ioVRefNum := wdParams.ioVRefNum;
  118.         ioFDirIndex := fileIndex;
  119.       END;
  120.     result := PBGetCatInfo(@paramBlock,FALSE);
  121.     IF (result = 0) 
  122.     AND NOT BitTst(@paramBlock.ioFlAttrib,3) 
  123.     AND (paramBlock.ioFlFndrInfo.fdType <> 'APPL') 
  124.     AND (paramBlock.ioFlFndrInfo.fdType <> 'FNDR') 
  125.     THEN DoOneFile;
  126.     fileIndex := fileIndex + 1;
  127.       UNTIL result = fnfErr;
  128.     END;
  129.  
  130.   BEGIN
  131.     WITH paramPtr^ DO
  132.       BEGIN
  133.         IF paramCount < 1 THEN
  134.       BEGIN
  135.         returnValue := PasToZero('search which folder?');
  136.         EXIT(GetDocs);
  137.       END;
  138.     ReturnToPas(params[1]^,pathName);
  139.         deskTop := OpenRFPerm('DeskTop',0,fsRdPerm);
  140.     DoOnePath;
  141.     CloseResFile(deskTop);
  142.       END;
  143.   END;
  144.  
  145. END.
  146.  
  147.  
  148.  
  149.